home *** CD-ROM | disk | FTP | other *** search
/ Wonky Flux Batch 2019 02 / Wonky_Flux_Batch_2019-02.zip / Wonky Flux Batch 2019-02 / 072 - EXFER 4.1 4.2.dsk / EXFER.AUX.S < prev    next >
Text File  |  2019-02-17  |  22KB  |  625 lines
  1.                          ; *****************************
  2.                          ;
  3.                          ;            EXfer:
  4.                          ; The Extended Transfer Module
  5.                          ;
  6.                          ;  This program is for use on
  7.                          ;  the ProDOS version of GBBS
  8.                          ;         "Pro" 1.3
  9.                          ;
  10.                          ;   Created and Copyrighted
  11.                          ;        1986 and 1987
  12.                          ;     by Mike Golaszewski
  13.                          ;
  14.                          ;   Copyright 1988 by G-Tech
  15.                          ;     All Rights Reserved
  16.                          ;
  17.                          ; *****************************
  18.  
  19.                          ; auxilliary function segment, version 4.2
  20.  
  21.                          ; created 6/20/88 - modified 7/30/88
  22.  
  23.                          ; define linkable lables
  24.  
  25.           public aux.aux
  26.  
  27.           on nocar goto terminate
  28.  
  29.           push return
  30.  
  31.           if i$="C" goto copy
  32.           if i$="H" goto help
  33.           if i$="K" goto kill
  34.           if i$="M" goto message
  35.           if i$="V" goto view
  36.           if i$="W" goto wallet
  37.  
  38.                          ; return to the main EXfer segment
  39.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  40.  
  41. return
  42.           link "a:exfer.seg","prompt"
  43.  
  44.                          ; show credits available and library info
  45.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  46.  
  47. wallet
  48.           print 'Your wallet has 'cr' credits....
  49.  
  50. Uploads   to this library pay 'um' credits per kilobyte
  51. Downloads cost 'dm' credits per kilobyte.
  52.  
  53. Current   protocol: '    ;:if pt print "Ymodem batch":return
  54.           print "Xmodem":return
  55.  
  56.                          ; display help on a command
  57.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~
  58.  
  59. help
  60.           print "Help on which command? ->";:get i$:if i$="" return
  61.           x$="CDFHIKLMNRSTVX?BGQWY":x=instr(i$,x$):if x=0 return
  62.           ready "d:hlp.exfer":print \\s$\:input #msg(x),a,x$
  63.           input #6,x$:setint(1):print x$\:copy #6:setint("")
  64.           ready d2$:return
  65.  
  66.                          ; message to librarian
  67.                          ; ~~~~~~~~~~~~~~~~~~~~
  68.  
  69. message
  70.           print screen$"Enter feedback: ["edit(3)"] cols, [4K] Max"
  71.           print "[DONE] when finished, [.H] for help":edit(0)
  72.           edit(1):if not(edit(2)) then return:else ready "g:mail"
  73.           d=b1:if not(d) then d=1
  74.           if info(6)<29 print \"XT: Bit-map full!":ready d2$:return
  75.           print #msg(d),un:print #6,"EXfer: Feedback from a user."\
  76.           print #6,"From ->"a1$" "a2$" [#"un"]"
  77.           print #6,"Date ->"date$" "time$\:copy #8,#6
  78.           print #msg(d),chr$(4);chr$(0);
  79.           msg(d)=1:update:ready d2$:return
  80.  
  81.                          ; view a file
  82.                          ; ~~~~~~~~~~~
  83.  
  84. view
  85.           if not(b3) goto lsec
  86.           input @2 "View:" i$:if i$="" return
  87.           if (val(i$)) or (left$(i$,1)="#") gosub nread:goto view.x
  88.           i$=left$(i$+chr$(32,14),15):gosub read
  89.           if not(l) goto nfile
  90.  
  91. view.x
  92.           if not(l) goto nfile
  93.           if not(byte(9)) print '
  94. XT:       This file must first be validated
  95.              by the sysop before it can be
  96.              accessed....':return
  97.           gosub name:f$=bf$+f$:gosub dtype
  98.           if ty$<>"TXT" print \"XT: Not a TXT type file....":return
  99.           gosub chkfil:if a close:goto nfile
  100.           print \s$\:setint(1):copy #1:close
  101.           setint(""):if not(lb) then cr=cr-((byte(10)+byte(11)*256)/2)*dm
  102.           return
  103.  
  104.                          ; show file info
  105.                          ; ~~~~~~~~~~~~~~
  106.  
  107. aux.aux
  108.           on nocar goto terminate
  109.           ready d2$:push aux.aux
  110.           if f$="aux.info" gosub info
  111.           if f$="directory" gosub directory
  112.           if f$="global" gosub global
  113.           if f$="new" gosub new
  114.           if f$="search" gosub search
  115.           pop:link "a:exfer.seg","prompt"
  116.  
  117.                          ; get filename & look for info
  118.  
  119. info
  120.           d=0:input @2 "Info on:" i$:if i$="" return:else na$=i$
  121.           if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto info.x
  122.           i$=left$(i$+chr$(32,14),15):gosub read
  123.           if not(l) goto nfile
  124.  
  125.                          ; see if the file has information
  126.  
  127. info.x
  128.           if l<0 goto nfile:else c=byte(12)+byte(13)*256:d=byte(14)
  129.           if (not(byte(9))) and (not(lb)) goto unval
  130.           if (not(d)) and (lb or (c=un)) goto info.a
  131.           if not(d) print xt$;chr$(7)"File has no information":return
  132.  
  133.                          ; display file information
  134.  
  135. info.1
  136.           input #msg(d),z:input #6,i$:gosub name:print \s$\
  137.           setint(1):print "Filename:";:if lb print bf$;f$:else print i$
  138.           copy #6:setint(""):if lb or (c=un) goto info.a
  139.           return
  140.  
  141.                          ; see if info is to be added or updated
  142.  
  143. info.a
  144.           if d print xt$"Edit this information? ([Y]/N):";:else print '
  145. XT:       Would you like to enter a short
  146.              description of this upload? ([Y]/N):';
  147.           input @2 i$:i$=left$(i$,1):if i$="N" return
  148.           edit(0):if d input #msg(d),a:input #6,x$\y$\z$:copy #6,#8
  149.           gosub edesc:if not(edit(2)) return:else if d goto info.e
  150.           a=1:gosub findinfo
  151.  
  152.                          ; replace information
  153.  
  154. info.s
  155.           open #1,d1$:position #1,32,l+1:input #1,na$:close
  156.           kill #msg(d):print #msg(d),un:print #6,na$
  157.           print #6,"Uploader: "a1$" "a2$" [#"un"]"
  158.           print #6,"Uploaded: "date$" "time$\:copy #8,#6
  159.  
  160.                          ; update the message file & rewrite directory entry
  161.  
  162. info.b
  163.           msg(d)=255:update:open #1,d1$:position #1,32,l+1
  164.           input #1,na$:input #1,ty$:read #1,ram2+9,10:byte(14)=d
  165.           position #1,32,l+1:print #1,na$:print #1,ty$
  166.           write #1,ram2+9,10:close
  167.           return
  168.  
  169.                          ; info already exists
  170.  
  171. info.e
  172.           input #msg(d),a:input #6,x$\y$\z$:kill #msg(d)
  173.           print #msg(d),a:print #6,x$\y$\z$\:copy #8,#6:goto info.b
  174.  
  175.  
  176.                          ; SUBROUTINE - find an empty message entry
  177.  
  178. findinfo
  179.           if msg(a) then a=a+1:else d=a:return
  180.           if a>msg(0) then d=a:return
  181.           goto findinfo
  182.  
  183.  
  184.                          ; kill a file
  185.                          ; ~~~~~~~~~~~
  186.  
  187.                          ; make sure the file belongs to the user
  188.  
  189. kill
  190.           input @2 "Kill:" i$:if i$="" return
  191.           if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto kill.x
  192.           i$=left$(i$+chr$(32,14),15):gosub read
  193.           if not(l) goto nfile
  194.  
  195. kill.x
  196.           if l<0 goto nfile
  197.           if lb goto kill.1:else a=byte(12)+byte(13)*256
  198.           if a<>un print \"XT: That is not your file.":return
  199.  
  200.                          ; kill the file
  201.  
  202. kill.1
  203.           gosub name:i$="Y"
  204.           if info(5) input @2 \"XT: Remove file from disk? ([Y]/N):" i$
  205.           f$=bf$+f$:x=byte(14):fill ram2+9,32,0:if i$<>"N" kill f$
  206.           open #1,d1$:position #1,32,l+1:print #1,chr$(13):write #1,ram2+9,30:close
  207.           if not(v) then nibble(3)=nibble(3)-(a=un):else ul=ul-(a=un)
  208.           if not(x) goto getslt
  209.  
  210.                          ; scan for the message containing file's information
  211.  
  212. kill.2
  213.           msg(x)=0:kill #msg(x):update:goto getslt
  214.  
  215.                          ; copy a file
  216.                          ; ~~~~~~~~~~~
  217.  
  218. copy
  219.           if not(b4) goto lsec:else if nb=255 goto dfull
  220.           input @2 "Copy:" i$:if i$="" return
  221.           na$=left$(i$+chr$(32,14),15):i$=na$:gosub read
  222.           gosub name:f$=bf$+f$:gosub chkfil:close
  223.           if a and not(l) goto copy.2
  224.           if lb goto copy.1:else print '
  225. XT:       'chr$(7)"Duplicate name on ProDOS volume.":return
  226.  
  227.                          ; see what sysop wishes to do with duplicate
  228.  
  229. copy.1
  230.           if l then nb=l
  231.           input @2 \"XT: File exists....overwrite? ([Y]/N):" i$
  232.           if i$="N" return:else kill f$
  233.  
  234.                          ; get the text
  235.  
  236. copy.2
  237.           print screen$'
  238. For       files exceeding 4096 bytes, use the
  239. R)eceive  command....
  240.  
  241. Enter     text: 'edit(3)' columns, [4K] max
  242. [DONE]    when finished, [.H] for help'
  243.           edit(0):edit(1):if not(edit(2)) return
  244.           input @2 \"XT: Is this a Ymodem list macro? ([Y]/N):" i$
  245.  
  246.                          ; get some info on the file
  247.  
  248.           create f$:open #1,f$:copy #8,#1:close
  249.           nibble(3)=nibble(3)+1:gosub size:gosub sfile
  250.           byte(14)=0:byte(15)=0:ty$="TXT":if i$<>"N" then ty$="LST"
  251.           push getslt:if nb<>byte(4) goto write:else goto update
  252.  
  253.                          ; catalog a library
  254.                          ; ~~~~~~~~~~~~~~~~~
  255.  
  256.                          ; print directory headers
  257.  
  258. directory
  259.           print screen$:gosub dir.h
  260.           if not(b3) print "XT:"chr$(7)" Directory disallowed....":goto getslt
  261.           use "d:xtyp",bf$
  262.  
  263.                          ; grab an entry
  264.  
  265.           open #1,d1$:for l=1 to byte(4):f$=""
  266.           position #1,32,l+1:input #1,f$:input #1,ty$
  267.           position #1,32,l+1,20:read #1,ram2+9,10:if f$="" goto dir.1
  268.           setint(1)
  269.  
  270.                          ; if its valid, print it
  271.  
  272.           gosub dir.e:print:if byte(9) goto dir.1
  273.           if (not(byte(9))) and (not(lb)) goto dir.1
  274.  
  275.                          ; update if not validated
  276.  
  277.           print \chr$(7,3)"XT: Validate above file? (Y/N/K):";:get i$
  278.           print chr$(8,35);chr$(32,35);chr$(8,35)
  279.           if i$="Y" position #1,32,l+1,20:print #1,chr$(255);
  280.           if i$<>"K" goto dir.1:else position #1,32,l+1:fill ram2+9,31,0
  281.           print #1,chr$(13):write #1,ram2+9,30:i$=f$:gosub name
  282.           kill f$:if l<nb then nb=l
  283.  
  284. dir.1
  285.           if key(1) then l=byte(4)
  286.           next:close:setint("")
  287.           x=peek(865)+peek(866)*256:y=peek(867)+peek(868)*256
  288.           z=x-y:print \chr$(14)"Kbytes Free:"left$(str$(z)+chr$(32,4),5);
  289.           print "    "   ;right$("   Kbytes Used:"+str$(y),17);
  290.           if edit(3)>39 print chr$(32,10)"Total Kbytes:"x:else print
  291.           return
  292.  
  293.                          ; :::::::::::::::::::::::::::::::
  294.                          ; "directory display" subroutines
  295.                          ; :::::::::::::::::::::::::::::::
  296.  
  297.                          ; show a directory header
  298.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  299.  
  300. dir.h
  301.           print right$("00"+str$(bb),3)": "bn$;
  302.           if edit(3)>39 print chr$(32,23)"Librarian:";
  303.           print " "right$("00"+str$(b1),3)\\" #  Filename       Type ";
  304.           if edit(3)<79 print "Size Dated Cost"\:return
  305.           print "I Size Uploaded Uploader Downloaded Credits Misc"\
  306.           return
  307.  
  308.                          ; show a directory entry
  309.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  310.  
  311. dir.e
  312.           print right$("00"+str$(l+1),3)" "f$" "ty$" ";:if edit(3)<79 goto dir.x
  313.           if byte(14) print "Y ";:else print "N ";
  314.  
  315. dir.x
  316.           x=byte(10)+byte(11)*256:print right$("   "+str$(x),4)" ";
  317.           b$=when$:a$=right$(b$,3)+left$(b$,5):y=byte(18):x=byte(12)+byte(13)*256
  318.           if edit(3)<79 goto dir.40
  319.           if not(byte(9)) poke 50,255:print chr$(15)"VALIDATE!"chr$(14);:poke 50,0
  320.           if (byte(9)) and (lc$>a$) print b$;:goto dir.c
  321.           if not(byte(9)) goto dir.c
  322.           poke 50,255:print chr$(15)"NEW FILE"chr$(14);:poke 50,0
  323.  
  324. dir.c
  325.           print " User "right$("00"+str$(x),3)" "right$("  "+str$(y),3)" times  ";
  326.           x=((byte(10)+byte(11)*256)/2)*dm:print right$("      "+str$(x),7)" ";
  327.           if lc$<=a$ print "NEW";
  328.           return
  329.  
  330. dir.40
  331.           if not(byte(9)) print " VAL ";
  332.           if (lc$>a$) and (byte(9)) print left$(b$,5);:else if byte(9) print " NEW ";
  333.           x=((byte(10)+byte(11)*256)/2)*dm:if cr>=x print "$";:else print " ";
  334.           print right$("   "+str$(x),4);:return
  335.  
  336.                          ; new file search
  337.                          ; ~~~~~~~~~~~~~~~
  338.  
  339. new
  340.           print screen$"XT: ";
  341.           if i$="N" print "Display new files....":else print "Scan files by date...."
  342.           if i$="N" then c=1:goto new.1
  343.           print xt$"Default date is "mid$(lc$,4,5);left$(lc$,3)
  344.           print xt$"Enter new date or press [RETURN] to"
  345.           input @2 "    accept default:" i$:if i$="" then i$=lc$:goto new.1
  346.           if (mid$(i$,3,1)<>"/") or (mid$(i$,6,1)<>"/") print '
  347. XT:       Please use the form: MM/DD/YY....';:get i$:print:i$="Q":goto new
  348.           c=3:i$=right$(i$,3)+left$(i$,5)
  349.  
  350. new.1
  351.           print:gosub scanvol:gosub security:x=b:print \s$:goto scanit
  352.  
  353.                          ; search for a file
  354.                          ; ~~~~~~~~~~~~~~~~~
  355.  
  356. search
  357.           b=0:input @2 "Find:" i$:if i$="" return
  358.           print:gosub scanvol:print screen$"XT: Searching for...."\"  :>"i$\\s$
  359.           gosub security:c=2:x=b:goto scanit
  360.  
  361.                          ; global file list
  362.                          ; ~~~~~~~~~~~~~~~~
  363.  
  364. global
  365.           print screen$'XT: Global directory of all accessable
  366.              downloads....'\:gosub scanvol
  367.           c=4:gosub security:x=b:print \s$:goto scanit 
  368.  
  369.                          ; :::::::::::::::::::::::::::::::::::::::::::
  370.                          ; subroutines for various "file scan" options
  371.                          ; :::::::::::::::::::::::::::::::::::::::::::
  372.  
  373.                          ; get a starting library number
  374.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  375.  
  376. scanvol
  377.           input @2 "XT: Starting at library? [1] #" x$:if x$="" then b=1
  378.           if not(b) then b=val(x$):if (b<1) or (b>255) print '
  379. XT:       'chr$(7)"That library doesn't exist!":pop:return
  380.           f$="d:xv."+str$(b):gosub chkfil:close:if not(a) return
  381.           print xt$      ;chr$(7)"Starting library doesn't exist!":pop:return
  382.  
  383.                          ; search for and display a particular file entry
  384.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  385.  
  386. scanit
  387.           b=1:ob=bb:for z=x to 255:setint(1):flag=ram2+32:y=flag(z):flag=ram+22
  388.           if key(1) then z=255:next:goto scanit.3
  389.           if y goto scanit.1:else next:goto scanit.3
  390.  
  391.                          ; log to the library and show we are examining it
  392.  
  393. scanit.1
  394.           bb=z:gosub log:if b print xt$"Scanning library #"right$("00"+str$(bb),3);
  395.           if not(b) print chr$(8,3);right$("00"+str$(bb),3);
  396.           if bf$="" then l=z:gosub biterr:next:goto scanit.3
  397.           if not(b2) next:goto scanit.3
  398.           b=0:open #1,d1$:for l=1 to byte(4):position #1,l+1,32
  399.           input #1,f$:if f$="" goto scanit.2
  400.           input #1,ty$:read #1,ram2+9,10:b$=when$
  401.           a$=right$(b$,3)+left$(b$,5):setint(1)
  402.  
  403.                          ; do necessary checks for whatever scan function we are using
  404.  
  405.           if (c=1) and (lc$<=a$ or not(byte(9))) goto scanit.d
  406.           if (c=2) and (instr(i$,f$)) goto scanit.d
  407.           if (c=3) and (i$<=a$) goto scanit.d
  408.           if (c=4) goto scanit.d
  409.           goto scanit.2
  410.  
  411.                          ; display the file entry on the screen
  412.  
  413. scanit.d
  414.           b=b+1:if b=1 print chr$(8,25);:gosub dir.h
  415.           gosub dir.e:print
  416.  
  417.                          ; we are finished, or interrupted
  418.  
  419. scanit.2
  420.           if key(1) then l=byte(4):z=255
  421.           next:close:setint(""):next
  422.  
  423. scanit.3
  424.           print:bb=ob:goto log
  425.  
  426.                          ; user has dropped carrier
  427.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~
  428.  
  429. terminate
  430.           link "a:exfer.seg","terminate"
  431.  
  432.                          ; ::::::::::::::::::::
  433.                          ; disk I/O subroutines
  434.                          ; ::::::::::::::::::::
  435.  
  436.                          ; get an empty slot
  437.                          ; ~~~~~~~~~~~~~~~~~
  438.  
  439. getslt
  440.           nb=0:open #1,d1$:for l=1 to byte(4)
  441.           position #1,32,l+1:input #1,i$
  442.           if (i$="") and (nb=0) then nb=l:l=byte(4)
  443.           next:close:if not(nb) then nb=byte(4)
  444.           return
  445.  
  446.                          ; update "number of entries" counter
  447.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  448.  
  449. update
  450.           byte(4)=byte(4)+1:open #1,d1$:print #1,bn$
  451.           print #1,bf$:write #1,ram2,9:close
  452.  
  453.                          ; write a directory entry
  454.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  455.  
  456. write
  457.           open #1,d1$:position #1,32,nb+1:print #1,na$
  458.           print #1,ty$:write #1,ram2+9,10:close
  459.           z=nb:return
  460.  
  461.                          ; read a directory entry
  462.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  463.  
  464. read
  465.           open #1,d1$:for l=1 to byte(4)
  466.           position #1,32,l+1:input #1,f$
  467.           if instr(i$,f$)=1 then p=l:l=byte(4):next:l=p:goto read.1
  468.           next:close #1:l=0:return
  469.  
  470. read.1
  471.           input #1,ty$:read #1,ram2+9,10:close #1
  472.           return
  473.  
  474.                          ; read a file by slot #
  475.                          ; ~~~~~~~~~~~~~~~~~~~~~
  476.  
  477. nread
  478.           if left$(i$,1)="#" then i$=mid$(i$,2)
  479.           l=val(i$):if (l<2) or (l>253) then l=0:return
  480.           open #1,d1$:position #1,32,l
  481.           input #1,f$:if f$="" close #1:l=0:return
  482.           input #1,ty$:read #1,ram2+9,10:close #1
  483.           i$=f$:if pt=2 return:else print \"XT: [#"l"]: "i$:return
  484.  
  485.                          ; find the type of a file
  486.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  487.  
  488. dtype
  489.           use "d:xtyp",f$:x=peek(ram2+32)
  490.           x$="???0TXT4PDA5BIN6ADB25AWP26ASP27SRC176OBJ177LIB178S16179RTL180EXE181"
  491.           x$=x$+"STR182RIF183NDA184CDA185SET186PNT192PIC193ANI194FNT200PAS239CMD240"
  492.           x$=x$+"COM245P16249BAS252VAR253REL254SYS255"
  493.           ty$="":y=instr(str$(x),x$):if y then ty$=mid$(x$,y-3,3):return
  494.           ty$="$"+chr$(48+x/16+((x/16)>9)*7)+chr$(48+x mod 16+((x mod 16)>9)*7)
  495.           return
  496.  
  497.                          ; return the size of F$ in A
  498.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~
  499.  
  500. size
  501.           open #1,f$:a=size(1)/2+1:close:return
  502.  
  503.                          ; see if file exists
  504.                          ; ~~~~~~~~~~~~~~~~~~
  505.  
  506. chkfil
  507.           open #1,f$:a=mark(1):return
  508.  
  509.                          ; :::::::::::::::::::
  510.                          ; special subroutines
  511.                          ; :::::::::::::::::::
  512.  
  513.                          ; convert to a valid ProDOS name
  514.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  515.  
  516.                          ; shorten I$ to directory length
  517.  
  518. name
  519.           if len(i$)>15 then i$=left$(i$,15)
  520.           i$=i$+chr$(1)
  521.  
  522.                          ; make sure the first char is a letter
  523.  
  524. name.0
  525.           a=asc(left$(i$,1)):if a=1 pop:return
  526.           if (a>64) and (a<91) then i$=left$(i$,len(i$)-1):goto name.1
  527.           if (a>96) and (a<123) then i$=left$(i$,len(i$)-1):goto name.1
  528.           i$=mid$(i$,2):goto name.0
  529.  
  530.                          ; remove symbols from the name
  531.  
  532. name.1
  533.           f$="":for x=1 to len(i$):a=asc(mid$(i$,x,1))
  534.           if (a>64) and (a<91) goto name.2
  535.           if (a>96) and (a<123) goto name.2
  536.           if (a>47) and (a<58) goto name.2
  537.           if a=46 goto name.2:else goto name.3
  538.  
  539.                          ; add a valid character
  540.  
  541. name.2
  542.           f$=f$+chr$(a)
  543.  
  544.                          ; if we dont have a name, return to the prompt
  545.  
  546. name.3
  547.           next:if f$="" pop:return
  548.           if len(f$)>15 then f$=left$(f$,15)
  549.           return
  550.  
  551.                          ; set file information
  552.                          ; ~~~~~~~~~~~~~~~~~~~~
  553.  
  554. sfile
  555.           byte(9)=byte(3):byte(10)=a mod 256:byte(11)=a/256
  556.           byte(12)=un mod 256:byte(13)=un/256:byte(18)=0
  557.           when$="x":if lb then byte(9)=255
  558.           return
  559.  
  560.                          ; get a file description
  561.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  562.  
  563. edesc
  564.           print '
  565. Enter     description: 'edit(3)' cols, [4K] max 
  566. [DONE]    when finished, [.H] for help'
  567.           edit(1):return
  568.  
  569.                          ; :::::::::::::
  570.                          ; directory I/O
  571.                          ; :::::::::::::
  572.  
  573.                          ; log to a library and get some dir info
  574.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  575.  
  576. log
  577.           byte=ram2:fill ram2,32,0:bf$="":z$="d:xv."+str$(bb)
  578.           open #1,z$:input #1,bn$:input #1,bf$
  579.           read #1,ram2,9:close:b1=byte(5)+byte(6)*256
  580.           b2=1:if byte(0) then b2=flag(byte(0))
  581.           b3=1:if byte(1) then b3=flag(byte(1))
  582.           b4=1:if byte(2) then b4=flag(byte(2))
  583.           um=byte(7):dm=byte(8):lb=(un=b1)
  584.           if info(5) then lb=1:b2=1:b3=1:b4=1
  585.           d1$="d:xv."+str$(bb):d2$="d:dv."+str$(bb)
  586.           if bf$ ready d2$:bf$=left$(bf$,instr(":",bf$))
  587.           return
  588.  
  589.                          ; update errant bit-map
  590.                          ; ~~~~~~~~~~~~~~~~~~~~~
  591.  
  592. biterr
  593.           open #1,"d:xt.bitmap":read #1,ed+1,255:close
  594.           poke ed+l,255:open #1,"d:xt.bitmap"
  595.           write #1,ed+1,255:close:open #1,"d:xt.volumes"
  596.           position #1,32,l:print #1,chr$(13):close
  597.           return
  598.  
  599.                          ; move security flags from EDIT(5) to RAM2+32
  600.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  601.  
  602. security
  603.           open #1,"d:xt.bitmap":read #1,ed+1,255:close:fill ram2+32,32,0
  604.           for l=1 to 255:if peek(ed+l)>34 next:return
  605.           x=peek(ed+l):if (flag(x)) or (x=0) then flag=ram2+32:flag(l)=1:flag=ram+22
  606.           next:return
  607.  
  608.                          ; ::::::::::::::
  609.                          ; error messages
  610.                          ; ::::::::::::::
  611.  
  612. lsec
  613.           print \"XT:"chr$(7)" Security too low....":return
  614.  
  615. dfull
  616.           print \"XT:"chr$(7)" Directory full....":return
  617.  
  618. nfile
  619.           print \"XT:"chr$(7)" No such file....":return
  620.  
  621. unval
  622.           print xt$      ;chr$(7)'File must be validated before it
  623.              can be accessed....':return
  624.  
  625.